home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
ASSEMBLE
/
H055.ZIP
/
MAC
/
API.MLC
next >
Wrap
Text File
|
1988-01-01
|
16KB
|
446 lines
TITLE 'PC/370 APPLICATION PROGRAM INTERFACE SURBOUTINES'
* PGMID. API.MLC
* AUTHOR. DON HIGGINS.
* DATE. 11/03/87
* REMARKS. THIS SET OF CALLABLE SUBROUTINES SUPPORTS THE
* IBM PC 3270 APPLICATION PROGRAM INTERFACE (API) TO
* ALLOW PROGRAM SIMULATION OF 3270 TRANSACTIONS.
*
* THE CURRENT ENTRY POINTS AND ARGUMENTS ARE AS FOLLOWS:
*
* ENTRY FUNCTION ARGUMENTS
*
* APISTART START SESSION NONE
* APIAID WRITE AID KEY R1 = AID SCAN CODE
* APIWRITE WRITE KEYBOARD R1 = KEYBOARD PARM LIST WITH LENGTH
* FOLLOWED BY ASCII+SHIFT HWORDS
* APIREAD READ SCREEN R1 = ADDRESS OF 24 X 80 SCREEN AREA
* APIWAIT WAIT A WHILE R1 = SECONDS TO WAIT
*
* MAINTENANCE.
*
* 11/04/87 DSH 1. DEBUG ON LIVE SYSTEM TO FIX REVERSED LIST SEG:OFF,
* MVC'S WITHOUT EXPLICIT LENGTH TO ARG. LISTS, ETC.
* 11/05/87 DSH 1. ADD ARG. LIST RETURN CODE CHECKS TO QID, AID, AND
* COPY FUNCTIONS; FIX CKD ARG MVC, FIX WAIT TIME LOGIC.
* REMOVE TEST HOOKS TO SKIP INT 7A TEST AND SVC NOP
* 2. CHECK IF KEYBOARD ALREADY CONNECTED.
* 3. ADD READ OPERATOR INFORMATION TO DETECT INHIBIT AND
* WAIT FOR AID FUNCTION TO COMPLETE
* 11/09/87 DSH 1. ADD MIDNIGHT CHECK TO ELIMINATE ENDLESS LOOP
* 12/29/87 DSH 1. ADD APITRAN TO ISSUE ASCII CICS TRANSACTION ID
* PASSED IN R1 WITH LENGTH IN R2.
*
API CSECT
*
* START API INTERFACE TO ALLOW FOLLOWING READ/WRITE CALLS
*
ENTRY APISTART
APISTART EQU *
STM R14,R12,12(R13)
BALR R12,0
USING *,R12
LA R11,PCB
USING IHAPCB,R11
*
* VERIFY API INTERRUPT INSTALLED
*
LA R1,4*X'7A' ABSOLUTE ADDRESS OF PC INTERRUPT 7A
LA R2,4 LENGTH
MVCP ADDRAPI(R2),0,R1 COPY ADDRESS TO PC/370 ADDR SPACE
L R0,ADDRAPI
LTR R0,R0
***
* B APIOK ******* FORCE OK FOR TEST WITH SVC NOP'D
***
BNZ APIOK
WTO 'API INTERRUPT 7A NOT INSTALLED'
SVC EXIT
APIOK EQU *
LM R0,R3,=A(BUFFER,2*1920,0,X'20000000')
MVCL R0,R2
*
* GET GATE ID'S
*
LA R1,=C"SESSMGR "
BAL R14,GETID
MVC SESGID,PCDX SAVE SESSMGR GATE ID
LA R1,=C"KEYBOARD"
BAL R14,GETID
MVC KEYGID,PCDX SAVE KEYBOARD GATE ID
LA R1,=C"COPY "
BAL R14,GETID
MVC CPYGID,PCDX SAVE COPY GATE ID
LA R1,=C"OIAM "
BAL R14,GETID
MVC OIAGID,PCDX SAVE OIAM GATE ID
*
* GET SESSION ID
*
MVC PCAX,=X'0901' SET PARMS TO OBTAIN SESSION ID
MVC PCBX,=X'8020'
MVC PCCX,=X'0000'
MVC PCDX,SESGID
LA R1,QSIDPARM
SVC CVVASG
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO QUERY SESSION ID PARM
LA R1,QSNARRAY
SVC CVVASG
STCM 0,X'8',QSIDNASG+1
STCM 0,X'4',QSIDNASG
STCM 0,X'2',QSIDNAOF+1 SET SEG:OFFSET TO NAME ARRAY IN PARM
STCM 0,X'1',QSIDNAOF SET SEG:OFFSET TO NAME ARRAY IN PARM
SVC TRACE
DC C'QID'
BAL R10,APISVC GET SESSION ID
CLI QSIDPARM,0 CHECK API QID RETURN CODE (SEE 2-18)
BNE APIERR
*
* CONNECT TO KEYBOARD
*
MVC PCAX,=X'0901' SET PARMS TO CONNECT KEYBOARD
MVC PCBX,=X'8020'
MVC PCCX,=X'0000'
MVC PCDX,KEYGID
MVC KEYPARM(10),=XL10'00' CLEAR KEYPARM 2-28
MVC KEYPARM+2(1),SESSID
LA R1,KEYPARM
SVC CVVASG
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM
SVC TRACE
DC C'CKD'
BAL R10,APISVC CONNECT KEYBOARD
CLI KEYPARM,4 IS KEYBOARD ALREADY CONNECTED
BE CKDOK
CLI KEYPARM,0 CHECK CKD RETURN CODE (SEE 2-28)
BNE APIERR
CKDOK EQU *
LM R14,R12,12(R13)
SR R15,R15
BR R14
*
* WRITE AID CODE IN R1
*
ENTRY APIAID
APIAID EQU *
STM R14,R12,12(R13)
BALR R12,0
USING *,R12
LA R11,PCB
BAL R14,UNLOCK UNLOCK KEYBOARD
MVC PCAX,=X'0904' SET PARMS TO WRITE TO KEYBOARD
MVC PCBX,=X'8020'
MVC PCCX,=X'0000'
MVC PCDX,KEYGID
MVC KEYPARM(12),=XL12'00' CLEAR KEYPARM 2-37
MVC KEYPARM+2(1),SESSID
MVI KEYPARM+6,X'20' SINGLE KEY OPTION
STC R1,KEYPARM+8 STORE AID CHARACTER
MVI KEYPARM+9,X'00' SET AID SHIFT CODE TO ZERO (A-2)
LA R1,KEYPARM
SVC CVVASG
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM
SVC TRACE
DC C'AID'
BAL R10,APISVC WRITE KEYBOARD
CLI KEYPARM,X'12' CHECK API AID RC FOR AID GENERATED (2-39)
BNE APIERR
LM R14,R12,12(R13)
SR R15,R15
BR R14
*
* WRITE ASCII TRANSACTION (R1=ADDRESS AND R2=LENGTH)
*
ENTRY APITRAN
APITRAN EQU *
STM R14,R12,12(R13)
BALR R12,0
USING *,R12
LA R0,1(R2) R0 = NUMBER OF CHAR +1 (FOR ENTER KEY)
MH R0,=H'2'
STCM R0,X'2',WTRAN+1
STCM R0,X'1',WTRAN+0
LA R3,WTRAN+2
WMOVE EQU *
MVC 0(1,R3),0(R1) MOVE ASCII TRANACTION BYTE
MVI 1(R3),ASCICODE MOVE ASCII SHIFT BYTE
LA R1,1(R1)
LA R3,2(R3)
BCT R2,WMOVE
MVC 0(2,R3),=AL1(ENTERKEY,SCANCODE)
LA R1,WTRAN
B APIWRBE
*
* WRITE THE KEYBOARD STRING POINTED TO BY R1 (SEE 2-37)
*
* R1 MUST POINT TO 2 BYTE LENGTH CONTAINING 2*(NUMBER OF KEYS) FOLLOWED
* BY PAIRS OF ASCII CHARACTERS PLUS SHIFT CODES.
*
ENTRY APIWRITE
APIWRITE EQU *
STM R14,R12,12(R13)
APIWRBE EQU * BRANCH ENTRY FROM APITRAN
BALR R12,0
USING *,R12
LA R11,PCB
BAL R14,UNLOCK UNLOCK KEYBOARD
MVC PCAX,=X'0904' SET PARMS TO WRITE TO KEYBOARD
MVC PCBX,=X'8020'
MVC PCCX,=X'0000'
MVC PCDX,KEYGID
MVC KEYPARM(12),=XL12'00' CLEAR KEYPARM 2-37
MVC KEYPARM+2(1),SESSID
MVI KEYPARM+6,X'30' MULTIPLE KEY OPTION
SVC CVVASG CONVERT R1 KEY LIST ADDR TO SEG:OFFSET
STCM 0,X'8',KEYPARM+10+1
STCM 0,X'4',KEYPARM+10
STCM 0,X'2',KEYPARM+8+1 STORE SEGlOFF TO KEY LIST PARM
STCM 0,X'1',KEYPARM+8 STORE SEGlOFF TO KEY LIST PARM
LA R1,KEYPARM
SVC CVVASG
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM
SVC TRACE
DC C'WKL'
BAL R10,APISVC WRITE KEYBOARD
CLI KEYPARM,X'12' AID KEY GENERATED
BE APIWROK
CLI KEYPARM,0 CHECK API WKL WRITE RETURN CODE
BNE APIERR
APIWROK EQU *
LM R14,R12,12(R13)
SR R15,R15
BR R14
*
* READ CURRENT 24 X 80 3270 SCREEN INTO AREA AT R1
*
ENTRY APIREAD
APIREAD EQU *
STM R14,R12,12(R13)
BALR R12,0
USING *,R12
LA R11,PCB
BAL R14,UNLOCK
LR R9,R1 SAVE SCREEN ADDRESS
MVC PCAX,=X'0901' SET PARMS TO READ SCREEN
MVC PCBX,=X'8020'
MVC PCCX,=X'00FF'
MVC PCDX,CPYGID
MVC CPYPARM(26),=XL26'00' CLEAR COPY PARM 2-60
MVC CPYPARM+2(1),SESSID
L R1,=A(BUFFER)
SVC CVVASG CONVERT BUFFER TO SEG:OFFSET
STCM 0,X'8',CPYPARM+18+1
STCM 0,X'4',CPYPARM+18
STCM 0,X'2',CPYPARM+16+1 STORE SEG:OFF TO BUFFER
STCM 0,X'1',CPYPARM+16 STORE SEG:OFF TO BUFFER
MVI CPYPARM+9,X'02' SET SOURCE TYPE
LA R0,1919
STCM R0,2,CPYPARM+13
STC R0,CPYPARM+12 SET SOURCE ENDING CHARACTER OFFSET
MVI CPYPARM+21,X'05' SET TARGET TYPE TO PC ASCII BUFFER
MVI CPYPARM+24,X'00' SET NO 3270 ATTRIBUTES (SEE 2-62)
LA R1,CPYPARM
SVC CVVASG
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO CONNECT KEY PARM
SVC TRACE
DC C'CPY'
BAL R10,APISVC READ SCREEN
CLI CPYPARM,0 CHECK READ OK
BNE APIERR
L R2,=A(BUFFER)
LA R3,24
ROWLOOP EQU *
LA R1,80
LR R4,R9 SAVE STARTING ROW ADDRESS OF SCREEN
COLLOOP EQU * COPY ASCII TO SCREEN AREA FROM BUFFER
MVC 0(1,R9),0(R2)
LA R9,1(R9)
LA R2,2(R2) SKIP ATTIRBUTES
BCT R1,COLLOOP
TR 0(80,R4),TRTTAB CONVERT X'00' TO ASCII BLANKS
MVC 78(2,R4),=X'0D0A' FORCE CR AND LINE FEED ON EACH LINE
BCT R3,ROWLOOP
LM R14,R12,12(R13)
SR R15,R15
BR R14
*
* WAIT FOR (R1) SECONDS
*
ENTRY APIWAIT
APIWAIT EQU *
STM R14,R12,12(R13)
BALR R12,0
USING *,R12
LA R11,PCB
MH R1,=H'100' CONVERT TO 100TH SEC
ST R1,TARGET
LA R15,APISAVE CONNECT STD. SAVE AREA FOR CALL TO TIMER
ST R13,APISAVE+4
ST R15,8(R13)
LR R13,R15
CALL TIMER
ST R0,NOW TIME NOW
A R0,TARGET
ST R0,TARGET TIME AT END OF WAIT IN 100TH SEC.
WAITLOOP EQU *
CALL TIMER
CL R0,NOW CHECK IF TIME LESS DUE TO MIDNIGHT RESET
BL WAITEXIT YES, EXIT WAIT NOW
CL R0,TARGET
BL WAITLOOP
WAITEXIT EQU *
L R13,4(R13)
LM R14,R12,12(R13)
SR R15,R15
BR R14
*
* COMMON SUPPORT ROUTINES
*
* GETID - R1 = GATE NAME IN ASCII PADDED TO 8 CHARACTERS/ DX SET TO GATE ID
*
GETID EQU *
BALR R8,0
USING *,R8
ST R14,RTNSAV14
SVC CVVASG CONVERT R1=VA TO R0=SEG:OFF
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO NAME ID REQUEST PARM
MVC PCAX,=X'8100'
LA 1,PCB
SVC TRACE
DC C'GID'
BAL R10,APISVC ISSUE 7AH API INTERRUPT WITH PCB REGS VIA SVC
L R14,RTNSAV14
BR R14
*
* UNLOCK KEYBOARD WAIT LOOP
*
UNLOCK EQU * RETRY READ ON KEYBAORD INHIBIT
*
* CHECK IF INPUT INHIBITED AND REPEAT UNTIL CLEAR
*
BALR R8,0
USING *,R8
ST R14,RTNSAV14
STM R1,R2,UNLKSAVE
UNLKLOOP EQU *
SVC TRACE
DC C'ULK'
MVC PCAX,=X'0902' SET PARMS TO OBTAIN OIAM INHIBIT STATUS
MVC PCBX,=X'8020'
MVC PCCX,=X'00FF'
MVC PCDX,OIAGID
LA R1,OIAMPARM
SVC CVVASG
STCM 0,X'C',PCES
STCM 0,X'3',PCDI SET ES:DI TO OIAM PARM
MVC OIAMPARM(9),=XL9'00' CLEAR PARM
MVC OIAMPARM+2(1),SESSID
LA R1,OIABUF
SVC CVVASG CONVERT BUFFER TO SEG:OFFSET
STCM 0,X'8',OIAMPARM+6+1
STCM 0,X'4',OIAMPARM+6
STCM 0,X'2',OIAMPARM+4+1 STORE SEG:OFF TO BUFFER
STCM 0,X'1',OIAMPARM+4 STORE SEG:OFF TO BUFFER
MVI OIAMPARM+8,X'08' SET REQUIRED PARM
SVC TRACE
DC C'OIA'
BAL R10,APISVC GET OIA INHIBIT STATUS
CLI OIAMPARM,0 CHECK API OIA RETURN CODE (SEE 2-74)
BNE APIERR
TM OIABUF,X'38' TEST FOR ANY CHECK
BNZ APIERR
TM OIABUF,X'07' TEST FOR INHIBIT
BNZ UNLKLOOP YES, RETRY
LM R1,R2,UNLKSAVE
L R14,RTNSAV14 EXIT WHEN KEYBOARD UNLOCKED
BR R14
*
* API SVC
*
APISVC EQU *
BALR R7,0
USING *,R7
LR R1,R11
SVC TRACE
DC C'API '
***
SVC INT86
*** ******* NOP SVC FOR TEST **********
* MVC PCCX,=X'1200' ******* FORCE RC FOR TEST **********
***
SR R15,R15
IC R15,PCCX+1 SET R15 = RC
CLC PCCX,=X'1200' CHECK API ID AND SYSTEM RETURN CODE
BNE APIERR
BR R10
*
* FORCE INTERACTIVE DEBUG ON API ERROR FOR NOW
*
APIERR EQU *
SVC TRACE
DC C'BUG '
SVC EXIT
*
* COMMON DATA
*
LTORG
SESGID DC H'0' SESSMGR GATE ID
KEYGID DC H'0' KEYBOARD GATE ID
CPYGID DC H'0' COPY GATE ID
OIAGID DC H'0' OIAM GATE ID
DC C'*** OIAMPARM ***'
OIAMPARM DC XL9'00'
DC C'*** OIABUF ***'
OIABUF DC XL5'00'
DC C'*** QSIDPARM ***'
QSIDPARM DS 0X QUERY SESSION ID PARMLIST 2-12
DC X'00' RETURN CODE
DC X'00' FUNCTION CODE
DC X'01' OPTION CODE
DC X'45' DATA CODE
QSIDNAOF DC AL2(0) OFFSET TO NAME ARRAY
QSIDNASG DC AL2(0) SEGMENT FOR NAME ARRAY
DC CL8"SESSION" SESSION LONG NAME
DC C'*** QSNARRAY ***'
QSNARRAY DS 0X QUERY SESSION ID NAME ARRAY 2-13
DC X'0E' NAME ARRAY LENGTH (MANUAL SHOWS X'14' ?)
DC X'00' NUMBER OF MATCHING SESSIONS
DC X'00' SHORT NAME OF SESSION
DC X'00' TYPE OF SESSION
SESSID DC X'00' SESSION ID
DC X'00' RESERVED
DC CL8"SESSION" LONG NAME OF SESSION
DC C'*** KEYPARM ***'
KEYPARM DC XL12'00' KEYBOARD AID AND WRITE LIST PARM
DC C'*** CPYPARM ***'
CPYPARM DC XL26'00' SCREEN COPY PARM
ADDRAPI DC A(0) API INTERRUPT ADDRESS TESTED FOR NOT ZERO
TARGET DC F'0' TIME IN 100TH SECONDS AT END OF WAIT INTERVAL
NOW DC F'0' CURRENT TIME FOR MIDNIGHT CHECK
APISAVE DC 18F'0'
RTNSAV14 DC A(0)
UNLKSAVE DC 2F'0'
PCB DS 0F PC REGISTER AREA FOR MS-DOS INTERRUPTS VIA SVC 34
DC C'PCVT' IDENTIFIER REQUIRED BY SVC 34
DC X'007A' INTERRUPT FOR API COMMUNICATION WITH PC 3270 EMULATION
DC H'0' FLAG STATUS AFTER INTERRUPT
DC 4H'0' AX-DX
DC 4H'0' DS,SI,ES,DI
DC C'*** BUFFER ***'
TRTTAB DC X'20',255AL1(*-TRTTAB) CVT X'00' TO ASCII BLANK
ASCICODE EQU X'40' ASCII SHIFT CODE (SEE A-2)
SCANCODE EQU X'00' SCAN SHIFT CODE
ENTERKEY EQU X'58' SCANCODE ENTER KEY
WTRAN DS XL(2*1920+2+2) WORK AREA FOR ASCII TRANSACTION WITH SCANCODES
BUFFER DS XL(2*1920) WORK AREA FOR PC ASCII AND ATTRIBUTES COPY OF SCREEN
COPY CPY\EQUREGS
COPY CPY\EQUSVCS
COPY CPY\IHAPCB
END